home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / tdsrc / tabdlg.bas < prev    next >
Encoding:
BASIC Source File  |  1994-11-06  |  3.1 KB  |  78 lines
  1. Option Explicit
  2. Global Const AppName = "Tabbed Dialog"
  3. Global Const tsafLanguages = False
  4. Global Const Version = "1.00.000"
  5. Global Const OneAppOnly = True
  6.  
  7. Dim DlgCount                As Integer
  8.  
  9. Dim Dlgs()                  As Control
  10.  
  11. Sub TabsClick (MyDlg As PictureBox, x As Single, y As Single)
  12. Dim oSM As Integer, th As Integer, tc As Integer, i As Integer
  13.     th = MyDlg.TextHeight("Qq")
  14.     If y < th + 1 Then
  15.         tc = x \ MyDlg.ScaleWidth / (DlgCount + 1)
  16.         Dlgs(tc).ZOrder 0
  17.     End If
  18. End Sub
  19.  
  20. Sub TabsPaint (MyForm As Form)
  21. Dim i As Integer, oSM As Integer, th As Integer, tfw As Integer, j As Integer
  22. Dim k As Integer
  23. Dim MyControl As Control
  24. ReDim MyCaptions(0) As String
  25.     DlgCount = 0
  26.     For i = 0 To MyForm.Controls.Count - 1
  27.         If TypeOf MyForm.Controls(i) Is PictureBox Then
  28.             If Len(MyForm.Controls(i).Tag) Then
  29.                 ReDim Preserve MyCaptions(DlgCount)
  30.                 ReDim Preserve Dlgs(DlgCount)
  31.                 MyCaptions(DlgCount) = MyForm.Controls(i).Tag
  32.                 Set Dlgs(DlgCount) = MyForm.Controls(i)
  33.                 DlgCount = DlgCount + 1
  34.             End If
  35.         End If
  36.     Next i
  37.     DlgCount = DlgCount - 1
  38.     For i = 0 To DlgCount
  39.         Set MyControl = Dlgs(i)
  40.         MyControl.AutoRedraw = True
  41.         MyControl.BorderStyle = 0
  42.         oSM = MyControl.ScaleMode
  43.         MyControl.ScaleMode = 3
  44.         If th = 0 Then
  45.             th = MyControl.TextHeight("Qq") + 1
  46.             tfw = MyControl.ScaleWidth / (DlgCount + 1) - 1
  47.         End If
  48.         MyControl.Line (0, th)-(MyControl.ScaleWidth - 1, MyControl.ScaleHeight - 1), 0, B
  49.         MyControl.Line (1, th + 1)-(MyControl.ScaleWidth - 2, th + 1), QBColor(15)
  50.         MyControl.Line (1, th + 1)-(1, MyControl.ScaleHeight - 2), QBColor(15)
  51.         MyControl.Line (MyControl.ScaleWidth - 2, th + 1)-(MyControl.ScaleWidth - 2, MyControl.ScaleHeight - 2), QBColor(8)
  52.         MyControl.Line (1, MyControl.ScaleHeight - 2)-(MyControl.ScaleWidth - 1, MyControl.ScaleHeight - 2), QBColor(8)
  53.         For k = 0 To DlgCount
  54.             If k = j Then
  55.                 MyControl.Line (k * tfw + 1, th)-((k + 1) * tfw, th), QBColor(7)
  56.                 MyControl.Line (k * tfw + 2, th + 1)-((k + 1) * tfw - 1, th + 1), QBColor(7)
  57.                 MyControl.ForeColor = 0
  58.             Else
  59.                 MyControl.ForeColor = QBColor(8)
  60.             End If
  61.             MyControl.Line (k * tfw, th)-(k * tfw + 5, 0), 0
  62.             MyControl.Line (k * tfw + 1, th)-(k * tfw + 6, 0), QBColor(15)
  63.             MyControl.Line (k * tfw + 5, 0)-((k + 1) * tfw - 5, 0), 0
  64.             MyControl.Line (k * tfw + 6, 1)-((k + 1) * tfw - 5, 1), QBColor(15)
  65.             MyControl.Line ((k + 1) * tfw - 5, 0)-((k + 1) * tfw, th), 0
  66.             MyControl.Line ((k + 1) * tfw - 5, 2)-((k + 1) * tfw - 1, th + 1), QBColor(8)
  67.             MyControl.CurrentY = 1
  68.             MyControl.CurrentX = ((2 * k + 1) * tfw - MyControl.TextWidth(MyCaptions(k))) / 2
  69.             MyControl.Print MyCaptions(k)
  70.         Next k
  71.         j = j + 1
  72.         MyControl.ZOrder 0
  73.         MyControl.ScaleMode = oSM
  74.     Next i
  75.     Set MyControl = Nothing
  76. End Sub
  77.  
  78.